home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / tekemul.arc / TEKEMUL.BAS next >
Encoding:
BASIC Source File  |  1984-09-19  |  21.4 KB  |  319 lines
  1. 10 '      Terminal and Tektronix emulator
  2. 20 '      by  Greg Koskinen-Dodgson & Rick Pyra
  3. 30 '
  4. 40 '         December 1983  (Version 2.0)
  5. 50 '
  6. 60 ' Initializations for Tektronix emulation routines
  7. 70 '
  8. 80 DEFINT A-Z:BACK=9:FORE=3:BORD=9:TEX=3:BAD=0
  9. 90 SCREEN 0,0,0:KEY OFF:COLOR FORE,BACK,BORD:CLOSE:CLS
  10. 100 ON ERROR GOTO 790 'trap communication error on opening
  11. 110  ' define communication default values
  12. 120 FALSE=0:TRUE=NOT FALSE:XOFF$=CHR$(19):XON$=CHR$(17)
  13. 130 OLDX=0:BAUD$="9600":PARITY$="e":STP$="1":DATAS$="7":MONI$="A":GRPH$="D"
  14. 140 ' Define data structures and pointers for the screen address.
  15. 150 OPTION BASE 1:DIM CURR.ADDRS(4),NUMB$(4),SCRN$(5,23)
  16. 160 FOR J=1 TO 5:FOR I=2 TO 23:READ SCRN$(J,I):NEXT:NEXT
  17. 170 ' read the screens into scr1$, scr2$ etc
  18. 180 ' Define ASCII control characters
  19. 190 NUL=0:ENQ=5:BEL=7:BS=8:HT=9:LF=10:VT=11:FF=12:CR=13:CR$=CHR$(13):HIY=1:LOY=2:HIX=3:LOX=4:SO=14:SI=15:DC1=17:DC3=19:ETB=23:SSUB=26:ESC=27:GS=29:US=31:SP$=CHR$(32)
  20. 200 ' Define functions
  21. 210 'FUNCTION FNHIBITS :Returns the value of bits 6&7 from a value. This is to
  22. 220 '                   determine if the byte is a HiX, HiY, LoX or Loy code.
  23. 230 DEF FNHIBITS(ARG)=(ARG AND 96)\32
  24. 240 ' FUNCTION FNLOBITS  -  returns the value of the lower 5 bits from a value
  25. 250 DEF FNLOBITS(ARG)=ARG AND 31
  26. 260 TEKEMUL=0:GOSUB 860:FOR I=2 TO 13:LOCATE I,4,0:PRINT SCRN$(1,I);:NEXT
  27. 270 LOCATE 12,57,1:STUF$=INKEY$:IF STUF$="" THEN 270 ELSE LOCATE ,,0
  28. 280 IF STUF$<>CR$ THEN FILE$=STUF$+":":GOSUB 3500 ELSE GOSUB 3530
  29. 290 ' see if tekfile exists and is ok else construct it
  30. 300 COMFIL$=BAUD$+","+PARITY$+","+DATAS$+","+STP$+",CS,DS,CD"
  31. 310 LOCATE 16,10:PRINT "Time to flick your data set on now....";
  32. 320 OPEN"COM1:"+COMFIL$ AS #1
  33. 330 ON COM(1) GOSUB 410:COM(1) ON
  34. 340 OPEN "scrn:" FOR OUTPUT AS #2
  35. 350 ON KEY(6) GOSUB 2850:KEY(6) ON ' to the colr Setup menu
  36. 360 ON KEY(8) GOSUB 3400:KEY(8) ON ' MTS terminal mode
  37. 370 ON KEY(9) GOSUB 520:KEY(9) ON ' tektronix emulator
  38. 380 ON KEY(10) GOSUB 770:KEY(10) ON ' Exit to DOS
  39. 390 CLS:GOSUB 3460:LOCATE 1,1,1
  40. 400 B$=INKEY$:IF B$ = "" THEN 400 ELSE PRINT #1,B$;:GOTO 400
  41. 410 WHILE (NOT EOF(1)) AND LOC(1)>0 ' check for input char... if 1 then send
  42. 420    AB$ = INKEY$
  43. 430    IF AB$ <> "" THEN PRINT #1, AB$;
  44. 440    IF LOC(1)>=5000 THEN PRINT #1, XOFF$;:PAUSE=TRUE
  45. 450    IF LOC(1)>40 THEN A$=INPUT$(40,#1):I=1 ELSE A$=INPUT$(LOC(1),#1):I=1
  46. 460    IF I>LEN(A$) THEN 490 ELSE IF TEKEMUL THEN GOSUB 910:GOTO 480 ELSE ASCMID=ASC(MID$(A$,I,1))
  47. 470    IF ASCMID=0 OR ASCMID=19 OR ASCMID=17 OR ASCMID=127 THEN 480 ELSE IF ASCMID=13 THEN LOCATE ,1 ELSE IF ASCMID=10 THEN COL=POS(0):PRINT:LOCATE ,COL ELSE IF ASCMID<>8 THEN PRINT MID$(A$,I,1); ELSE IF POS(0)>=1 THEN LOCATE ,POS(0)-1
  48. 480    I=I+1:GOTO 460 ' fake NEXT statement
  49. 490    IF PAUSE THEN PRINT #1, XON$;:PAUSE=FALSE
  50. 500 WEND
  51. 510 ROW=CSRLIN:COL=POS(0):RETURN
  52. 520 ' Tektronix emulator menu (F9 Trap Routine)
  53. 530 GOSUB 3460:GOSUB 860 ' print out pf key assignment & set up scrn border
  54. 540 FOR I=2 TO 23:LOCATE I,4,0:PRINT SCRN$(5,I);:NEXT:LOCATE ,,1
  55. 550 LOCATE 9,30:PRINT"A";:LOCATE 10,30:PRINT"B";:LOCATE 11,30:PRINT"C";:LOCATE ASC(MONI$)-56,30:COLOR 15:PRINT MID$(MONI$,1,1);:COLOR FORE
  56. 560 ' Error out if no color monitor.
  57. 570 IF MONI$="C" THEN PRINT "Tektronix emulator cannot run without the color monitor.":END
  58. 580 LOCATE 14,30:PRINT"D";:LOCATE 15,30:PRINT"E";:COLOR 15:LOCATE ASC(GRPH$)-54,30:PRINT MID$(GRPH$,1,1);:COLOR FORE
  59. 590 LOCATE 9,30,1:STUF$=INKEY$:IF STUF$="" THEN 590
  60. 600 IF STUF$="a" OR STUF$="A" THEN MONI$="A" ELSE IF STUF$="b" OR STUF$="B" THEN MONI$="B" ELSE IF STUF$="c" OR STUF$="C" THEN MONI$="C":GOTO 570
  61. 610 LOCATE 9,30:PRINT"A";:LOCATE 10,30:PRINT"B";:LOCATE 11,30:PRINT"C";:LOCATE ASC(MONI$)-56,30:COLOR 15:PRINT MID$(MONI$,1,1);:COLOR FORE
  62. 620 LOCATE 14,30:STUF$=INKEY$:IF STUF$="" THEN 620 ELSE IF STUF$="d"OR STUF$="D" THEN GRPH$="D" ELSE IF STUF$="e" OR STUF$="E" THEN GRPH$="E"
  63. 630 IF GRPH$="D" THEN COLOR 15:PRINT"D";:COLOR FORE:LOCATE 15,30:PRINT"E";:GRPHCMD$="*IG" ELSE IF GRPH$="E" THEN GRPH$="E":PRINT"D":LOCATE 15,30:COLOR 15:PRINT"E";:COLOR FORE:GRPHCMD$="*PLOTSEE"
  64. 640 LOCATE 18,46:INPUT" :",OBJ$:OBJ$=MID$(OBJ$,1,16)
  65. 650 FOR I=16 TO 1 STEP -1
  66. 660 IF MID$(OBJ$,I,1)<>SP$ THEN LN=I:I=0
  67. 670 NEXT
  68. 680 OBJ$=MID$(OBJ$,1,LN)
  69. 690 ' Switch to the color monitor
  70. 700 DEF SEG = 0:J=PEEK(&H410):POKE &H410, (J AND &HCF) OR &H10:SCREEN 0:SCREEN 2:OUT 985,TEX:WIDTH 80:LOCATE ,,1,6,7
  71. 710 ' Set up initial Tektronix states
  72. 720 ' MODE=0 ===> Graph mode            MODE=1 ===> Alpha mode
  73. 730 TEKEMUL=1:MODE=1:ESCAPE=0:DARK=0
  74. 740 ' Plotsee & IG MTS $RUN command
  75. 750 COM(1) OFF:FOR IZ=1 TO 1000:NEXT:IF OBJ$="::" OR OBJ$="" THEN PRINT #1,"$RUN "GRPHCMD$ ELSE PRINT #1,"$RUN "OBJ$"+"GRPHCMD$
  76. 760 COM(1) ON:RETURN
  77. 770 ' F10 Routine.  End prgm. & Switch to monochrome dos
  78. 780 TEKEMUL=0:IF MONI$="B" THEN END ELSE DEF SEG=0:J=PEEK(&H410):K=J OR &H30:POKE &H410, K:SCREEN 0,0,0:WIDTH 80:LOCATE ,,1,12,13:COLOR FORE,BACK:END
  79. 790 'Error Trapping
  80. 800 IF ERL=320 OR ERR=24 OR ERR=25 OR ERL=450 THEN RESUME
  81. 810 LOCATE 10,20:IF ERR=27 THEN PRINT"Turn printer on, & load with paper";:BEEP:FOR I=1 TO 1800:NEXT:RESUME 350
  82. 820 COLOR 15:IF ERR=64 THEN PRINT"Please use the built-in facilities for saving profiles";:FOR I=1 TO 500:NEXT:BEEP:COLOR FORE:RESUME 260
  83. 830 IF ERR=52 THEN PRINT"Please use REAL drives only ";FILE$;" is not a good choice";:FOR I=1 TO 500:NEXT:BEEP:COLOR FORE:RESUME 260
  84. 840 IF ERR=53 THEN PRINT"File not on ";FILE$;" try again";:FOR I =1 TO 500:NEXT:BEEP:COLOR FORE:RESUME 260
  85. 850 ON ERROR GOTO 0
  86. 860 '
  87. 870 ' print out the screen border
  88. 880 LOCATE 1,3:PRINT "I";STRING$(74,"M");";";:LOCATE 2,3:PRINT ":";:LOCATE 2,78:PRINT ":";:LOCATE 3,1:PRINT "IM<";:LOCATE 3,78:PRINT "HM;";
  89. 890 FOR GG=4 TO 21:LOCATE GG,1:PRINT ":";:LOCATE GG,80:PRINT ":";:NEXT
  90. 900 LOCATE 22,1:PRINT "HM;";:LOCATE ,78:PRINT"IM<";:LOCATE 23,3:PRINT ":";║LOCATE ,78:PRINT":"╗:LOCATE 24,3:PRINT "H";STRING$(74,"M");"<";:LOCATE ,,0:RETURN
  91. 910 '  Subroutine TEKSIM
  92. 920 BYTE=ASC(MID$(A$,I,1))
  93. 930 IF ESCAPE THEN GOSUB 950 ELSE GOSUB 1070
  94. 940 RETURN
  95. 950 '  SUBROUTINE ESCAPE-TRUE  -  Called if the previous byte was an ESC char.
  96. 960 IF BYTE=FF THEN 990 ELSE IF BYTE=SSUB THEN 1000 ELSE IF BYTE=ENQ THEN 1010
  97. 970 IF BYTE=SI THEN 1020 ELSE IF BYTE=SO THEN 1030 ELSE IF BYTE=ETB THEN 1040
  98. 980 PRINT "Unexpected control character in ESCape sequence.":END
  99. 990 CLS:MODE=1:LOCATE 1,1,1:GOTO 1050   ' FF  encountered
  100. 1000 LOCATE ,1:PRINT "GIN Mode not available at this time.":STOP   ' SUB encountered
  101. 1010 GOTO 1050    ' ENQ encountered - nothing done at this time
  102. 1020 GOTO 1050    ' SI  encountered - nothing done at this time
  103. 1030 GOTO 1050    ' SO  encountered - nothing done at this time
  104. 1040 GOTO 1050    ' ETB encountered - nothing done at this time
  105. 1050 ESCAPE=0
  106. 1060 RETURN
  107. 1070 '  SUBROUTINE ESCAPE-FALSE  -  Called if the previous byte was not ESC
  108. 1080 IF BYTE>US  THEN 1270
  109. 1090 '  Here we have control characters to deal with
  110. 1100 IF BYTE=GS THEN 1160 ELSE IF BYTE=CR THEN 1180 ELSE IF BYTE=LF THEN 1190
  111. 1110 IF BYTE=ESC THEN 1200 ELSE IF BYTE=US THEN 1210
  112. 1120 IF BYTE=DC1 OR BYTE=DC3 OR BYTE=NUL THEN 1220
  113. 1130 IF BYTE=BS THEN 1230 ELSE IF BYTE=HT THEN 1240
  114. 1140 IF BYTE=VT THEN 1250 ELSE IF BYTE=BEL THEN 1260
  115. 1150 PRINT "Unexpected control character encountered.":STOP
  116. 1160 '  Set up the terminal for graphing a dark vector.
  117. 1170 MODE=0:DARK=1:BYTE.COUNT=0:RETURN   ' GS  encountered
  118. 1180 LOCATE ,1:MODE=1:RETURN   ' CR  encountered
  119. 1190 COL=POS(0):PRINT:LOCATE ,COL:RETURN   ' LF  encountered
  120. 1200 ESCAPE=1:RETURN   ' ESC encountered
  121. 1210 MODE=1:RETURN
  122. 1220 RETURN       ' NUL, DC1, or DC3 encountered - do nothing!
  123. 1230 IF POS(0) > 1 THEN LOCATE ,POS(0)-1:RETURN ELSE RETURN   ' BS  encountered
  124. 1240 IF POS(0) < 80 THEN LOCATE ,POS(0)+1:RETURN ELSE RETURN   ' HT  encountere
  125. 1250 RETURN       ' VT  encountered - not used at this time
  126. 1260 BEEP:RETURN       ' BEL encountered - not used at this time
  127. 1270 '  Here we have ASCII characters to deal with.  If Alpha mode, print
  128. 1280 '  them and RETURN
  129. 1290 IF MODE THEN PRINT CHR$(BYTE);:RETURN
  130. 1300 '  Decode the incoming ASCII characters into addresses.
  131. 1310 ON BYTE.COUNT+1 GOTO 1340, 1400, 1460, 1520
  132. 1320 '  Error message DECODE.1
  133. 1330 PRINT "Internal error at DECODE.1":STOP
  134. 1340 ' Byte count here is 0
  135. 1350 ON FNHIBITS(BYTE) GOTO 1370, 1380, 1390
  136. 1360    GOTO 1570
  137. 1370    CURR.ADDRS(HIY)=FNLOBITS(BYTE):BYTE.COUNT=1:GOTO 1560
  138. 1380    CURR.ADDRS(LOX)=FNLOBITS(BYTE):BYTE.COUNT=4:GOTO 1560
  139. 1390    CURR.ADDRS(LOY)=FNLOBITS(BYTE):BYTE.COUNT=1:GOTO 1560
  140. 1400 '  Byte count here is 1
  141. 1410 ON FNHIBITS(BYTE) GOTO 1430, 1440, 1450
  142. 1420    GOTO 1570
  143. 1430    CURR.ADDRS(HIX)=FNLOBITS(BYTE):BYTE.COUNT=2:GOTO 1560
  144. 1440    CURR.ADDRS(LOX)=FNLOBITS(BYTE):BYTE.COUNT=4:GOTO 1560
  145. 1450    CURR.ADDRS(LOY)=FNLOBITS(BYTE):BYTE.COUNT=2:GOTO 1560
  146. 1460 '  Byte count here is 2
  147. 1470 ON FNHIBITS(BYTE) GOTO 1490, 1500, 1510
  148. 1480    GOTO 1570
  149. 1490    CURR.ADDRS(HIX)=FNLOBITS(BYTE):BYTE.COUNT=3:GOTO 1560
  150. 1500    CURR.ADDRS(LOX)=FNLOBITS(BYTE):BYTE.COUNT=4:GOTO 1560
  151. 1510    GOTO 1570
  152. 1520 '  Byte count here is 3
  153. 1530 ON FNHIBITS(BYTE) GOTO 1570, 1550, 1570
  154. 1540    GOTO 1570
  155. 1550    CURR.ADDRS(LOX)=FNLOBITS(BYTE):BYTE.COUNT=4:GOTO 1560
  156. 1560 IF BYTE.COUNT=4 THEN GOTO 1590 ELSE RETURN
  157. 1570 '  Error message DECODE.2
  158. 1580 PRINT "Unexpected address code (at DECODE.2)":STOP
  159. 1590 '  Form the address of where to draw to next.
  160. 1600 '  Save the last set of coordinates.
  161. 1610 X.PREV=X.CURR:Y.PREV=Y.CURR
  162. 1620 '  Generate the new set of coordinates.
  163. 1630 X.CURR=((32*CURR.ADDRS(HIX))+CURR.ADDRS(LOX))*.6246335
  164. 1640 Y.CURR=-((((32*CURR.ADDRS(HIY))+CURR.ADDRS(LOY))*.2554557)-199)
  165. 1650 'If we have a dark vector then do nothing but set DARK to false.
  166. 1660 'If vector is not dark (ie. a line is to be drawn) then draw out a line
  167. 1670 IF DARK  THEN DARK=0:BYTE.COUNT=0:RETURN ELSE LINE (X.PREV,Y.PREV)-(X.CURR,Y.CURR):BYTE.COUNT=0:RETURN
  168. 1680 RETURN
  169. 1690 ' printer subroutine
  170. 1700 ' screen data section
  171. 1710 DATA "            I B M   P C   - Communication and Tektronix 4010     Menu #1"
  172. 1720 DATA "                                    Emulator program                    "
  173. 1730 DATA "                                                                        "
  174. 1740 DATA "       If you have set up a profile file to be used with this program   "
  175. 1750 DATA "       then just type the drive or pathname of where the file            "
  176. 1760 DATA "       TEKFILE.PRO can be found                                          "
  177. 1770 DATA "                                                                         "
  178. 1780 DATA "       If you do not have a profile file set up, then just hit enter     "
  179. 1790 DATA "                                                                         "
  180. 1800 DATA "                                                                         "
  181. 1810 DATA "            Enter the drive of the TEKFILE.PRO file:                     "
  182. 1820 DATA "                                                                         "
  183. 1830 DATA "                                                                         "
  184. 1840 DATA "                                                                         "
  185. 1850 DATA "                                                                         "
  186. 1860 DATA "                                                                         "
  187. 1870 DATA "                                                                         "
  188. 1880 DATA "                                                                         "
  189. 1890 DATA "                                                                         "
  190. 1900 DATA "                                                                         "
  191. 1910 DATA "                                                                         "
  192. 1920 DATA "                                                                         "
  193. 1930 DATA "            I B M   P C   - Communication and Tektronix 4010     Menu #2"
  194. 1940 DATA "                                    Emulator program                    "
  195. 1950 DATA "                                                                        "
  196. 1960 DATA "       This program emulates a terminal under MTS.  It also emulates the"
  197. 1970 DATA "       Tektronix 4010 graphics terminal when used with *IG or *PLOTSEE. "
  198. 1980 DATA "                                                                        "
  199. 1990 DATA "       Use of this package is quite simple.  Instructions are provided  "
  200. 2000 DATA "       to assist you.                                                   "
  201. 2010 DATA "       When prompted by MTS for terminal ID enter T4010.                "
  202. 2020 DATA "                                                                        "
  203. 2030 DATA "       Once you have signed onto MTS pressing F9 places you in Tektronix"
  204. 2040 DATA "       emulation mode.  At this time you will be prompted for some infor-"
  205. 2050 DATA "       mation.  After responding to a few questions the program will then"
  206. 2060 DATA "       switch you over to the color monitor and issue the $RUN command to"
  207. 2070 DATA "       initiate whatever graphics program you may have.                  "
  208. 2080 DATA "                                                                         "
  209. 2090 DATA "       Pressing F8 takes you out of Tektronix emulation mode & switches  "
  210. 2100 DATA "       you back to the monochrome monitor (if you have one).             "
  211. 2110 DATA "       Press F10 to exit to DOS.                                         "
  212. 2120 DATA "                                                                         "
  213. 2130 DATA "                                                                         "
  214. 2140 DATA "                                                                         "
  215. 2150 ' screen 3 data here
  216. 2160 DATA "                   Colour Option Screen                           Menu #3"
  217. 2170 DATA "                                                                         "
  218. 2180 DATA "                                                                         "
  219. 2190 DATA "         Choose the numbers opposite the colors for foreground,          "
  220. 2200 DATA "         background and border.  You can also choose the foreground        "
  221. 2210 DATA "         color that the tektronix print will use.                          "
  222. 2220 DATA "                                                                           "
  223. 2230 DATA "         0  - Black                  8 - Grey                              "
  224. 2240 DATA "         1  - Blue                   9 - Lt. Blue                          "
  225. 2250 DATA "         2  - Green                 10 - Lt. Green                         "
  226. 2260 DATA "         3  - Cyan                  11 - Lt. Cyan                          "
  227. 2270 DATA "         4  - Red                   12 - Lt. Red                           "
  228. 2280 DATA "         5  - Pink                  13 - Lt. Pink                          "
  229. 2290 DATA "         6 -  Brown                 14 - Yellow                            "
  230. 2300 DATA "         7 -  White                 15 - Hi White                          "
  231. 2310 DATA "                                                                           "
  232. 2320 DATA "                                                                           "
  233. 2330 DATA "        Foreground ( 3  )                                              "
  234. 2340 DATA "        Background ( 9  )                                              "
  235. 2350 DATA "        Border     ( 9  )                                              "
  236. 2360 DATA "        Tektronix  Foreground ( 3 )                                    "
  237. 2370 DATA "                                                                       "
  238. 2380 ' screen 4 data here
  239. 2390 DATA "         I B M   P C   -   Communication set-up                   Menu #4"
  240. 2400 DATA "                                                                          "
  241. 2410 DATA "         Press RETURN if you wish to use the currently Hi-lighted defaults."
  242. 2420 DATA "                                                                           "
  243. 2430 DATA "         Baud rate 9600                                                    "
  244. 2440 DATA "         Parity (e,o,n)                                                  "
  245. 2450 DATA "         Data size (7 or 8)                                              "
  246. 2460 DATA "         Stop bits (0, 1, 2 )                                            "
  247. 2470 DATA "                                                                         "
  248. 2480 DATA "         Correct (Y/N)                                                  "
  249. 2490 DATA "                                                                        "
  250. 2500 DATA "                                                                        "
  251. 2510 DATA "                                                                        "
  252. 2520 DATA "                                                                        "
  253. 2530 DATA "                                                                        "
  254. 2540 DATA "                                                                         "
  255. 2550 DATA "                                                                         "
  256. 2560 DATA "                                                                         "
  257. 2570 DATA "                                                                         "
  258. 2580 DATA "                                                                         "
  259. 2590 DATA "                                                                         "
  260. 2600 DATA "                                                                         "
  261. 2610 ' SCREEN 5
  262. 2620 DATA "                    I B M   P C  - Tektronix Emulator             Menu #5"
  263. 2630 DATA "                                                                         "
  264. 2640 DATA "                                                                         "
  265. 2650 DATA "         In order to use this feature properly we are going to have to   "
  266. 2660 DATA "         have you provide us with some more information.  Please bear in "
  267. 2670 DATA "         mind that this program will not 'walk the dog' and will         "
  268. 2680 DATA "         'not do windows'.                                               "
  269. 2690 DATA "    Do you have:          A     Both a colour & monochrome monitor attached."
  270. 2700 DATA "                          B     The colour monitor only                     "
  271. 2710 DATA "                          C     The monochrome monitor only                 "
  272. 2720 DATA "                                                                            "
  273. 2730 DATA "                                                                            "
  274. 2740 DATA "    Do you wish to run:   D    *IG                                          "
  275. 2750 DATA "               or         E    *PLOTSEE                                     "
  276. 2760 DATA "                                                                            "
  277. 2770 DATA "    Enter the name of the MTS object file to use (if there is no            "
  278. 2780 DATA "    object program to run, enter nothing):                                  "
  279. 2790 DATA "                                                                            "
  280. 2800 DATA "      á                   á                                                 "
  281. 2810 DATA "                                                                          "
  282. 2820 DATA "                                                                          "
  283. 2830 DATA "                                                                          "
  284. 2840 DATA "                                                                          "
  285. 2850 ' color selection subroutine
  286. 2860 GOSUB 3460:LOCATE ,,0:GOSUB 860:'print out screen border
  287. 2870 FOR I=2 TO 23:LOCATE I,4:PRINT SCRN$(3,I);:NEXT
  288. 2880 DIGIT=0:LOCATE 19,24,1:PRINT FORE;
  289. 2890 LOCATE 19,25+DIGIT:STUF$=INKEY$:IF STUF$="" THEN 2890
  290. 2900 IF DIGIT=0 AND STUF$=CR$ THEN GOTO 2990 ' default value taken
  291. 2910 DIGIT=DIGIT+1
  292. 2920 IF ASC(STUF$)-48<10 AND ASC(STUF$)-48>-1 OR STUF$=CR$ THEN 2940
  293. 2930 LOCATE 23,25:COLOR 31:PRINT"Use numbers only please";:COLOR FORE:GOTO 2880
  294. 2940 IF DIGIT=1 THEN FORE1=ASC(STUF$)-48:PRINT STUF$;:GOTO 2890
  295. 2950 IF DIGIT=2 AND STUF$=CR$ THEN FORE=FORE1:GOTO 2990
  296. 2960 FORE=FORE1*10+ASC(STUF$)-48
  297. 2970 IF FORE>31 THEN LOCATE 23,24:COLOR 31:PRINT"Use a number less than 32 please        ";:FORE=3:GOTO 2880
  298. 2980 LOCATE 23,24:COLOR ,BACK:PRINT"                                        ";
  299. 2990 LOCATE 19,24,1:COLOR FORE:PRINT FORE;
  300. 3000 DIGIT=0:LOCATE 20,24,1:PRINT BACK;
  301. 3010 LOCATE 20,25+DIGIT:STUF$=INKEY$:IF STUF$="" THEN 3010
  302. 3020 IF DIGIT=0 AND STUF$=CR$ THEN GOTO 3110 ' default value taken
  303. 3030 DIGIT=DIGIT+1
  304. 3040 IF ASC(STUF$)-48 < 10 AND ASC(STUF$)-48 > -1 OR STUF$=CR$ THEN 3060
  305. 3050 LOCATE 23,25:COLOR 31:PRINT"Use numbers only please";:COLOR FORE:GOTO 3000
  306. 3060 IF DIGIT=1 THEN BACK1=ASC(STUF$)-48:PRINT STUF$;:GOTO 3010
  307. 3070 IF DIGIT=2 AND STUF$=CR$ THEN BACK=BACK1:GOTO 3110
  308. 3080 BACK=BACK1*10+ASC(STUF$)-48
  309. 3090 IF BACK>15 THEN LOCATE 23,24:COLOR 31:PRINT"Use a number less than 16 please        ";:BACK=0:GOTO 3000
  310. 3100 LOCATE 23,25:PRINT"                       ";
  311. 3110 LOCATE 20,24,1:COLOR BACK:PRINT BACK;:COLOR FORE
  312. 3120 DIGIT=0:LOCATE 21,24,1:PRINT BORD;
  313. 3130 LOCATE 21,25+DIGIT:STUF$=INKEY$:IF STUF$="" THEN 3130
  314. 3140 IF DIGIT=0 AND STUF$=CR$ THEN GOTO 3220 ' default value taken
  315. 3150 DIGIT=DIGIT+1
  316. 3160 IF ASC(STUF$)-48 < 10 AND ASC(STUF$)-48 > -1 OR ASC(STUF$)=13 THEN 3180
  317. 3170 LOCATE 23,25:COLOR 31:PRINT"Use numbers only please";:COLOR FORE:GOTO 3120
  318. 3180 IF DIGIT=1 THEN BORD1=ASC(STUF$)-48:PRINT STUF$;:GOTO 3130
  319. 3190 IF DIGIT=2 AND STUF$=